Γραφήματα 2D

Επειδή το WLJS δεν υποστηρίζει όλα τα `PlotTheme` του Mathematica, υπάρχει η λύση του `MMAView` για όσους δουλεύουν στο WLJS. Συγκεκριμένα, ενώ επί παραδείγματι το παρακάτω δεν εμφάνιζε κάτι: `Plot[f[x], {x, -8, 8}, PlotTheme -> "Marketing"]` γράφοντας τελικά: `Plot[f[x], {x, -8, 8}, PlotTheme -> "Marketing"]//MMAView` εμφανίζεται το γράφημα όπως ακριβώς το παράγει το Mathematica. Για να μην προκύψουν παρανοήσεις σχετικά με τις εντολές της γλώσσας Wolfram, θα εφαρμόσουμε καθολικά το `MMAView`.


                Unprotect[ToString];
ToString[expr: _[__], StandardForm] := With[{view = MMAView[expr]}, ExportString[
    StringReplace[
        (view // ToBoxes) /. {RowBox->RowBoxFlatten} // ToString
    , {"\[NoBreak]"->""}]
, "String"]];
Protect[ToString];

Απλές περιπτώσεις


                Clear["Global`*"]
f[x_] :=  x^2
Plot[f[x], {x, -8, 8}]
DiscretePlot[f[x], {x, -8, 8}]

Παρουσίαση

Γραμμή


                Clear["Global`*"]
f[x_] :=  x^2
Plot[f[x], {x, -8, 8}]
Plot[f[x], {x, -8, 8}, PlotStyle -> Dashed]
Plot[f[x], {x, -8, 8}, PlotStyle -> Thick]

Υπόβαθρο


                Plot[f[x], {x, -8, 8}, Background -> White]
Plot[f[x], {x, -8, 8}, Background -> Lighter[Gray, 0.5]]
Plot[f[x], {x, -8, 8}, Background -> Lighter[Gray, 1]]
Plot[f[x], {x, -8, 8}, Background -> LightBlue]

Πλαίσιο


                Plot[f[x], {x, -8, 8}, PlotTheme -> "Monochrome"]
Plot[f[x], {x, -8, 8}, PlotTheme -> "Scientific"]
Plot[f[x], {x, -8, 8}, PlotTheme -> "Classic"]
Plot[f[x], {x, -8, 8}, PlotTheme -> "Detailed"]
Plot[f[x], {x, -8, 8}, PlotTheme -> "Marketing"] 
Plot[f[x], {x, -8, 8}, PlotTheme -> "Business"]

Ετικέτες


                Clear["Global`*"]
f[x_] := a^x
numOfa = 10;
aMin = 1.05;
aMax = 4.1;
(*Λίστα συναρτήσεων*)
fList1 = Evaluate[Table[f[x], {a, aMin, aMax, (aMax - aMin)/numOfa}]];

(*Λίστα χρωμάτων*)
thermList=Table[ColorData["TemperatureMap"][0.5` +n],{n,0,0.5,0.5/numOfa}];

p1 = Plot[fList1, {x, -6, 6},
  AspectRatio -> 7/12, 
  PlotStyle -> thermList,
  PlotLegends -> Placed[fList1, Below], 
  PlotRange -> {-1, 6}]

Άλλες ενδείξεις στους άξονες


                Clear["Global`*"]
y0 = 0.5;
y1 = 3.5;
S = 2;
k = 1.6;
d = 1;
colorF = Blue;
tc = Log[Abs[S - y0]/y0]/(k S);
lgcL[t_] := y0 S/(y0 + (S - y0) Exp[-k S t])
lgcG[t_] := y1 S/(y1 + (S - y1) Exp[-k S t])
Plot[{lgcL[t], lgcG[t]}, {t, tc - 3, 4},  
 Background -> LightGray, AxesLabel -> {"t", "y"}, 
 Ticks -> {None, {{S, "S"}}}]


                Clear["Global`*"]
f[x_] := Sin[ x]
Plot[f[x], {x, -Pi - 0.5, 3 Pi + 0.5}, AspectRatio -> 3/(4 Pi + 1), 
 PlotRange -> {-1.5, 1.5}, 
 PlotLabel -> "f(x)=ημ(x), \nΤ=2π, min=-1, max=1", 
 Ticks -> {Range[-Pi, 3 Pi, Pi/2], Automatic}, ImageSize -> Large]


                Clear["Global`*"]
center = Row[{#, Invisible[#]}, "\[NegativeThickSpace]"] &;
d = Range[10];
xticks = 
  Table[{n, 
    center@Rotate["The y value is " <> ToString[n], 45 Degree]}, {n, 
    d}];
ListPlot[d, Frame -> True, 
 FrameTicks -> {{Automatic, None}, {xticks, None}}]
xticks2 = Table[{n^2, "x=" <> ToString[n] <> "^2"}, {n, 5}];
f[x_] := x^2
Plot[f[x], {x, -1, 26}, Ticks -> {xticks2, Automatic}]

Κατακόρυφες και οριζόντιες γραμμές


                Clear["Global`*"]
f[x_] := Exp[x];
Plot[f[x], {x, -1, 2}, GridLines -> {{Pi/2, 0.5}, {2}}]
Plot[f[x], {x, -1, 2}, GridLines -> {{{Pi/2, Red}, {0.5, Thick}}, {{2, Blue}}}]

Εύρος


                Clear["Global`*"]
a = 0.01;
f[x_] := 1/(x^2 + a) + Sqrt[1 - x^2]
Plot[f[x], {x, -2, 2}]
Plot[f[x], {x, -2, 2}, PlotRange -> All]
Plot[f[x], {x, -2, 2}, PlotRange -> Full]
Plot[f[x], {x, -2, 2}, PlotRange -> {{0, 1}, {0, 10}}]

Μεγεθύνσεις


                Clear["Global`*"]
(*Θέση κόκκινου ορθογωνίου*)
xPos = 15.5;
(*Εύρος κόκκινου ορθογωνίου*)
range = 0.2;
f[x_] := 1/x;
xyMinMax = {{xPos - range, 
    xPos + range}, {f[xPos] - range*GoldenRatio^-1, 
    f[xPos] + range*GoldenRatio^-1}};
(*Θέση πορτοκαλί ορθογωνίου*)
posFrame = {14, 5};
Plot[f[x], {x, -2, 20}, PlotRange -> {-2, 8}, AspectRatio -> 10/22, 
 Epilog -> {Transparent, EdgeForm[{Thick, Red}], 
   Rectangle[Sequence @@ Transpose[xyMinMax]], 
   Inset[Plot[f[x], {x, xPos - range, xPos + range}, Frame -> True, 
     FrameStyle -> Orange, Axes -> False, PlotRange -> xyMinMax, 
     ImageSize -> 270], posFrame]}, ImageSize -> 700]

Χρωματισμός βάσει ύψους


                Clear["Global`*"]
f[x_] := x^2 + 20 Cos[x]
(*Βλ. επίσης Color Schemes*)
Plot[f[x], {x, 0, 10}, PlotStyle -> Thick, ColorFunction -> Function[{x, y}, ColorData["NeonColors"][y]]]
 
Plot[f[x], {x, 0, 10}, PlotStyle -> Thick, ColorFunction -> Function[{x, y}, ColorData["ThermometerColors"][y]]]

Plot[f[x], {x, 0, 10}, PlotStyle -> Thick, ColorFunction -> Function[{x, y}, ColorData["SunsetColors"][y]]]

Plot[f[x], {x, 0, 10}, PlotStyle -> Thick, ColorFunction -> Function[{x, y}, ColorData["TemperatureMap"][y]]]

Plot[f[x], {x, 0, 10}, PlotStyle -> Thick, ColorFunction -> Function[{x, y}, ColorData["AlpineColors"][y]]]

Χρωματισμός βάσει μονοτονίας


                Clear["Global`*"]
f[x_] := x^2 + 20 Cos[x]
colorFunction = 
  ColorData["Rainbow"][0.5 + ArcTan[#/10]/Pi] &@
    First@Ratios[First@Differences[#]] &;
Plot[f[x], {x, -10, 10}] /. 
 Line[p_] :> ({colorFunction[#], Line[#]} & /@ Partition[p, 2, 1])


                accessibleRainbow = Import["https://pastebin.com/raw/8ngJtMtU"];
colorFunction = 
  accessibleRainbow[0.5 + ArcTan[#/10]/Pi] &@
    First@Ratios[First@Differences[#]] &;
Plot[f[x], {x, -10, 10}] /. 
 Line[p_] :> ({colorFunction[#], Line[#]} & /@ Partition[p, 2, 1])


                Clear["Global`*"]
f[x_] := x^2 + 20 Cos[x]
fPrimeNum[x_] := Evaluate[D[f[x], x]];

(*Find the maximum absolute derivative value for normalization*)
maxDerivative = MaxValue[{Abs[fPrimeNum[x]], -10 <= x <= 10}, x];

(*Define a color function based on the magnitude and sign of the \
derivative*)
colorFunction[x_] := 
 ColorData["TemperatureMap"][0.5 + 0.5 fPrimeNum[x]/maxDerivative]

Plot[f[x], {x, -10, 10}, PlotStyle -> Thick, 
 ColorFunction -> Function[{x, y}, colorFunction[x]], 
 ColorFunctionScaling -> False, PlotPoints -> 200, MaxRecursion -> 4, 
 Exclusions -> None, Background -> Gray]


                fPrime = D[f[x], x]; (*Compute the symbolic derivative*)

(*Convert the symbolic derivative into a numerical function*)
fPrimeNum = Function[x, fPrime];

(*Normalizing the derivative to the range[0,1] for use with Hue*)
colorFunction[x_] := Hue[(Sign[fPrimeNum[x]] + 1)/3]

Plot[f[x], {x, -10, 10}, 
 ColorFunction -> Function[{x, y}, colorFunction[x]], 
 ColorFunctionScaling -> False]


                cf = Function[x, Blend[{Green, Red}, Rescale[Clip[f'[x], {-50, 50}], {-50, 50}, {0, 1}]]];
Plot[f[x], {x, -10, 10}, ColorFunction -> cf, 
 ColorFunctionScaling -> False]

Για γέμισμα


                Clear["Global`*"]
f[x_] := -x^2+1
horiz = -3;
Plot[f[x], {x, 0, 5}, Filling -> horiz, FillingStyle -> {Red, Blue}]
g[x_] := -1 + x + x^2
Plot[{f[x], g[x]}, {x, 0, 3}, Filling -> {1 -> {2}},  FillingStyle -> {Red, Blue}]

Ανοιχτά σημεία (holdot)


                Clear["Global`*"]
f[x_] := (1 + 2 Exp[1/x])/(1 + Exp[1/x])
Plot[f[x], {x, -3, 3}, ColorFunction -> "TemperatureMap", 
 PlotRange -> {{-2, 2}, {-0.5, 2.5}}, AspectRatio -> 3/4, 
 Epilog -> {PointSize[0.03], Blue, Point[{0, 1}], PointSize[0.02], 
   LightGray, Point[{0, 1}], PointSize[0.03], Red, Point[{0, 2}], 
   PointSize[0.02], LightGray, Point[{0, 2}]}]

Συνάρτηση με παράμετρο


                Clear["Global`*"]
f[x_] := a* x^2


                Table[Plot[a x^2, {x, -8, 8}, PlotLabel -> "a=" <> ToString[a]], {a, -4, 4}]


                numOfa = 10;
aMax = 50;
fList = Evaluate[Table[f[x], {a, 0, aMax, aMax/numOfa}]];
grayList = Table[GrayLevel[n], {n, 0, 0.5, 0.5/numOfa}];
Plot[fList, {x, -8, 8}, PlotRange -> All, PlotStyle -> grayList]


                fListCol = Evaluate[Table[f[x], {a, -aMax, aMax, 2 aMax/numOfa}]];
colList = Table[ColorData["TemperatureMap"][n], {n, 0, 1, 1/numOfa}];
Plot[fListCol, {x, -8, 8}, PlotRange -> All, PlotStyle -> colList]


                Clear["Global`*"]
f[x_] := a^x
numOfa = 10;
aMin = 1.05;
aMax = 4.1;
fList1 = 
  Evaluate[Table[f[x], {a, aMin, aMax, (aMax - aMin)/numOfa}]];
thermList = 
  Table[ColorData["TemperatureMap"][0.5 + n], {n, 0, 0.5, 0.5/numOfa}];
  Clear["Global`*"],Null,f[x_]:=(*SpB[*)Power[a(*|*),(*|*)x](*]SpB*),Null,numOfa=10;,Null,aMin=0.05`;,Null,aMax=0.9`;,Null,fList1=Evaluate[Table[f[x],{a,aMin,aMax,(*FB[*)((aMax-aMin)(*,*)/(*,*)(numOfa))(*]FB*)}]];,Null,coldList=Table[ColorData["TemperatureMap"][n],{n,0,0.5`,(*FB[*)((0.5`)(*,*)/(*,*)(numOfa))(*]FB*)}];,Null,p2=Plot[fList1,{x,-6,6},AspectRatio -> (*FB[*)((7)(*,*)/(*,*)(12))(*]FB*),PlotStyle -> coldList,PlotLegends -> Placed[fList1,Below],PlotRange -> {-1,6},PlotLabel -> "f(x)=\!\(\*SuperscriptBox[\(α\), \(x\)]\)",ImageSize -> Medium]p1=Plot[fList1,{x,-6,6},AspectRatio -> (*FB[*)((7)(*,*)/(*,*)(12))(*]FB*),PlotStyle -> thermList,PlotLegends -> Placed[fList1,Below],PlotRange -> {-1,6},PlotLabel -> "f(x)=\!\(\*SuperscriptBox[\(α\), \(x\)]\)",ImageSize -> Medium]


                Clear["Global`*"]
f[x_] := a^x
numOfa = 10;
aMin = 0.05;
aMax = 0.9;
fList1 = 
  Evaluate[Table[f[x], {a, aMin, aMax, (aMax - aMin)/numOfa}]];
coldList = 
  Table[ColorData["TemperatureMap"][n], {n, 0, 0.5, 0.5/numOfa}];
  p2=Plot[fList1,{x,-6,6},AspectRatio -> (*FB[*)((7)(*,*)/(*,*)(12))(*]FB*),PlotStyle -> coldList,PlotLegends -> Placed[fList1,Below],PlotRange -> {-1,6},PlotLabel -> "f(x)=\!\(\*SuperscriptBox[\(α\), \(x\)]\)",ImageSize -> Medium]

Πολλές συναρτήσεις μαζί


                Clear["Global`*"]
f[x_] := x^2 - x
g[x_] := Sin[x]


                Plot[{f[x], g[x]}, {x, -2, 6}, PlotTheme -> "Monochrome", PlotLegends -> {"Cf", "Cg"}]


                Plot[{f[x], g[x]}, {x, -2, 6}, PlotLegends -> {"Cf", "Cg"}]

Πολικές συντεταγμένες


                Clear["Global`*"]
r1[th_] := 1 + 1/10 Sin[10 th]
r2[th_] := th + 1/10 Sin[10 th]
PolarPlot[{r1[th], r2[th]}, {th, 0, 2 Pi}]
PolarPlot[r1[th], {th, 0, 2 Pi}, PlotTheme -> "Business"]

Παραμετρικές καμπύλες $(x(t),y(t))$


                Clear["Global`*"]
x[t_] := 2 Sin[t]
y[t_] := 3 Cos[t]


                ParametricPlot[{x[t], y[t]}, {t, 0, 2 Pi}]


                ParametricPlot[{{2 x[t] - 3, 3 y[t] - 2}, {{x[t] - y[t], x[t] + y[t]}}}, {t, 0, 2 Pi}]

Πεπλεγμένες


                Clear["Global`*"]
f[x_, y_] := x^2 - x y^2
ContourPlot[f[x, y] == 1, {x, -2, 2}, {y, -3, 3}]